home *** CD-ROM | disk | FTP | other *** search
/ The Glitch Apple Disk Collection / 2014.glitch.apple.collection.zip / indexed / 9B.DSK / POLICE ARTIST.V1.83.bas < prev    next >
BASIC Source File  |  2014-09-09  |  8KB  |  100 lines
  1. 0  REM    POLICE ARTIST.V1.83  (C) COPYRIGHT 1983 ELIZABETH LEVIN 
  2. 1  ONERR  GOTO 40000
  3. 100  HIMEM: 8192:V$ = "V1.83"
  4. 130 S =  -16336:BLANK$ = "                                        ": DATA  32,74,255,173,48,192,136,208,5,206,1,3,240,9,202,208,245,174,0,3,76,5,3,32,63,255,96: FOR X = 770 TO 796: READ Y: POKE X,Y: NEXT : DATA     101,90,85,80,71,67, 191,161,120,95: DIM RIGHT(9): FOR X = 0 TO 9: READ RIGHT(X): NEXT 
  5. 190  DATA HAIR,CHIN,EYES,NOSE,MOUTH,"  DONE  ":NP = 6: DIM FACE$(NP): FOR X = 1 TO NP: READ FACE$(X): NEXT 
  6. 220 L$ = "HBCDFGWZLMNPRSTVKAE": DATA   A,E,I,O,U,EE,EA,OA,OO,AI,IA,IE,OU,AU,OI,OY,      E,ER,ELL,ICK,ING,COCK,WOOD,ORTH,MAN,SON,STEIN,SKY,BY,LY,MORE,: DIM LS$(16,2): FOR Y = 1 TO 2: FOR X = 1 TO 16: READ LS$(X,Y): NEXT : NEXT 
  7. 230  DIM FACE%(5,1): GOSUB 30000:MAX = 2 ^(LVL +1)
  8. 310  HOME : GOSUB 2000: VTAB 21: HTAB 1: INVERSE : PRINT BLANK$;BLANK$;
  9. 400  REM 
  10. 420 PK = 0:OV = 0:THIS = 0: GOSUB 5000: IF OV  THEN 700
  11. 515  IF   NOT INST  THEN  GOSUB 3450
  12. 520 THIS = 1: GOSUB 3000:THIS = 0:INST = 1: VTAB 23: HTAB 1: CALL  -958: INVERSE : VTAB 21: HTAB 1: PRINT  LEFT$(BLANK$,25): PRINT  LEFT$(BLANK$,25):RIGHT = 0: FOR PART = 1 TO 5: IF FACE%(PART,0) = FACE%(PART,1)  THEN RIGHT = RIGHT +1
  13. 530  NEXT : NORMAL :Z$ = "AT LARGE": IF RIGHT = 5  THEN Z$ = "IDENTIFIED": GOSUB 2000: GOSUB 7000: GOSUB 2100: GOTO 620
  14. 550  GOSUB 7000: FOR PART = 1 TO 5: IF FACE%(PART,0) = FACE%(PART,1)  THEN  INVERSE : POKE 768,RIGHT(PART): POKE 769,60: CALL 770: GOTO 590
  15. 580  FOR X = 1 TO 50:SS =  PEEK(S): NEXT 
  16. 590  GOSUB 3300: NORMAL : FOR X = 1 TO 100: NEXT : NEXT :: FOR X = 55 TO 255  STEP 10: POKE 768,X: POKE 769,5: CALL 770: NEXT : INVERSE 
  17. 620  GOSUB 2200: IF RIGHT = 5  AND PK < = OSC%  THEN OSC% = PK: FLASH : GOSUB 3700: FOR X = 1 TO 3: FOR Z = 1 TO 2: FOR Y = 5 +Z TO 7 +Z: POKE 768,RIGHT(Y)/4: POKE 769,Y *2 *Z: CALL 770: NEXT : NEXT : NEXT 
  18. 630  IF RIGHT = 5  THEN  INVERSE : GOSUB 3700
  19. 640  IF RIGHT = 5  AND OSC% <OSC%(LVL)  THEN  GOSUB 30380
  20. 650  GOTO 400
  21. 700  VTAB 1: NORMAL : PRINT : PRINT D$;"RUN HELLO,D1"
  22. 1000  REM 
  23. 1010 X = 0:Y = 0: IF FACE%(P,THIS)  THEN  POKE 768,20: POKE 769,3: CALL 770
  24. 1020 L = PART%(P,SCL%(P,FACE%(P,THIS))) +L1: POKE 36352,L - INT(L/256) *256: POKE 36353, INT(L/256): IF THIS  THEN X = X +140
  25. 1050  POKE 36354,X -(X >255) *256: POKE 36355,X >255: POKE 36356,Y: CALL 36361: RETURN 
  26. 2000  REM 
  27. 2030  HCOLOR= 3: HPLOT 0,0: CALL 62454: RETURN 
  28. 2100  REM 
  29. 2110 H = 1: FOR X = 1 TO 3:H =   NOT H: HCOLOR= 4 -H: FOR Y = 0 TO 2: HPLOT 3 +Y,3 +Y TO 137 -Y,3 +Y TO 137 -Y,159 -Y TO 3 +Y,159 -Y TO 3 +Y,3 +Y: NEXT : FOR Z = 1 TO 2: FOR Y = 5 +Z TO 7 +Z: POKE 768,RIGHT(Y)/2: POKE 769,Y *2 *Z: CALL 770: NEXT : NEXT : NEXT : RETURN 
  30. 2200  REM 
  31. 2210  VTAB 22: HTAB 4: PRINT  LEFT$(BLANK$,14): VTAB 21: HTAB 4: PRINT  LEFT$(BLANK$,14);: SPEED= 50: HTAB 5 +(6 - LEN(NAME$)/2): FOR X = 1 TO  LEN(NAME$): PRINT  MID$ (NAME$,X,1);:SS =  PEEK(S): NEXT : PRINT : HTAB 5 +(6 - LEN(Z$)/2): FOR X = 1 TO  LEN(Z$): PRINT  MID$ (Z$,X,1);:SS =  PEEK(S): NEXT : SPEED= 255: RETURN 
  32. 3000  REM 
  33. 3010  IF OV  THEN 3290: REM 
  34. 3020  VTAB 23: HTAB 1: CALL  -958: FOR X = 5 TO 1  STEP  -1: IF FACE%(X,THIS) = 0  THEN PART = X
  35. 3030  NEXT : NORMAL : VTAB 24: HTAB 1: CALL  -958:H = 1: FOR X = 1 TO NP: HTAB H: PRINT FACE$(X);:H = H +6: NEXT 
  36. 3060  IF PART <1  THEN PART = NP
  37. 3070  IF PART >NP  THEN PART = 1
  38. 3080  FLASH : GOSUB 3300: NORMAL : GET ANS$:KEY =  ASC(ANS$) +128: GOSUB 9000: IF ANS$ = " "  THEN  GOSUB 3600: GOTO 3250
  39. 3090  IF ANS$ =  CHR$(21)  THEN  GOSUB 3300::PART = PART +1: GOTO 3060
  40. 3100  IF ANS$ =  CHR$(8)  THEN  GOSUB 3300:PART = PART -1: GOTO 3060
  41. 3110  IF ANS$ < > CHR$(13)  THEN  GOSUB 3400: GOTO 3060
  42. 3130  IF PART = NP  THEN 3290: REM 
  43. 3140  VTAB 23: HTAB 1: CALL  -958: FLASH : GOSUB 3300: NORMAL :FACE%(PART,1) =  INT( RND(1) *MAX) +1
  44. 3150  IF FACE%(PART,THIS) <1  THEN FACE%(PART,THIS) = MAX
  45. 3160  IF FACE%(PART,THIS) >MAX  THEN FACE%(PART,THIS) = 1
  46. 3170  GOSUB 2000:P = PART: GOSUB 1000: GET ANS$:KEY =  ASC(ANS$) +128: GOSUB 9000:: IF ANS$ = " "  THEN  GOSUB 3600: GOTO 3250
  47. 3180  IF ANS$ =  CHR$(21)  THEN FACE%(PART,THIS) = FACE%(PART,THIS) +1: GOTO 3150
  48. 3190  IF ANS$ =  CHR$(8)  THEN FACE%(PART,THIS) = FACE%(PART,THIS) -1: GOTO 3150
  49. 3200  IF ANS$ < > CHR$(13)  THEN  GOSUB 3400: GOTO 3150
  50. 3210  FOR P = 1 TO 5: IF P < >PART  THEN  GOSUB 1000
  51. 3220  NEXT 
  52. 3250 PART = NP: GOTO 3000
  53. 3290  RETURN 
  54. 3300  REM 
  55. 3310 SS =  PEEK(S): VTAB 24: HTAB (PART -1) *6 +1:H = 1 + PEEK(36): PRINT FACE$(PART);: VTAB 24: HTAB H: RETURN 
  56. 3400  IF KEY = 147  THEN 3470
  57. 3410  FOR X = 1 TO 50:SS =  PEEK(S): NEXT 
  58. 3450  VTAB 21: HTAB 2: PRINT "RETURN=SELECT          ": HTAB 2: PRINT "ARROWS=SEEK  SPACE=PEEK": VTAB 1
  59. 3470  RETURN 
  60. 3600  REM 
  61. 3610  INVERSE : VTAB 23: HTAB 1: CALL  -958: VTAB 21: PRINT  LEFT$(BLANK$,25): PRINT  LEFT$(BLANK$,25):THIS = 0: GOSUB 7000: NORMAL : VTAB 24: HTAB 1: PRINT "PRESS ";: FLASH : PRINT "SPACE BAR";: NORMAL : PRINT " TO STOP PEEKING";
  62. 3620  POKE  -16368,0
  63. 3630 PK = PK +1: INVERSE : VTAB 22: HTAB 26: PRINT "PEEK TIME ";PK;"  ";: NORMAL : POKE 768,225: POKE 769,10: CALL 770: FOR Y = 1 TO 380: NEXT 
  64. 3640 KEY =  PEEK( -16384): POKE  -16368,0: GOSUB 9000: IF KEY < >160  THEN  GOTO 3630
  65. 3660  VTAB 23: HTAB 1: CALL  -958:THIS = 1: GOSUB 7000: RETURN 
  66. 3700  REM 
  67. 3780  IF OSC% <32000  THEN  VTAB 21: HTAB 26: PRINT "BEST TIME ";OSC%;: VTAB 21: HTAB 1: NORMAL 
  68. 3785  RETURN 
  69. 4000  REM 
  70. 4005 Z$ = "CULPRIT": IF INST  THEN Z$ = "NEW " +Z$
  71. 4010  POKE  -16368,0: VTAB 23: HTAB 1: CALL  -958: NORMAL : PRINT "PRESS ";: FLASH : PRINT "SPACE BAR";: NORMAL : PRINT " TO PEEK AT ";Z$: IF INST  THEN  HTAB 10: PRINT "- OR PRESS ";: FLASH : PRINT "S";: NORMAL : PRINT " TO STOP";
  72. 4080 KEY =  PEEK( -16384):X =  RND(1): IF KEY <127  THEN 4080
  73. 4090  GOSUB 9000: POKE  -16368,0: IF KEY < >160  AND KEY < >211  THEN 4080
  74. 4100  RETURN 
  75. 5000  REM 
  76. 5010  GOSUB 4000: IF KEY = 211  THEN OV = 1: GOTO 5090
  77. 5020  INVERSE : VTAB 21: HTAB 26: PRINT  LEFT$(BLANK$,13): HTAB 26: PRINT  LEFT$(BLANK$,13): NORMAL 
  78. 5040  GOSUB 5100: FOR PART = 1 TO 5:FACE%(PART,0) =  INT( RND(1) *MAX) +1:FACE%(PART,1) = 0: NEXT : GOSUB 2000: GOSUB 3600:NAME$ =  MID$ (L$,SCL%(1,FACE%(1,0)) +3,1) +"." + MID$ (L$,SCL%(2,FACE%(2,0)),1) +LS$((SCL%(3,FACE%(3,0))),1) + MID$ (L$,SCL%(4,FACE%(4,0)) +1,1) +LS$((SCL%(5,FACE%(5,0))),2):Z =  FRE(0): GOSUB 2000
  79. 5090  RETURN 
  80. 5100  REM 
  81. 5110  IF MAX = MX  THEN  FOR PART = 1 TO 5: FOR X = 1 TO MAX:SCL%(PART,X) = X: NEXT :SS =  PEEK(S): NEXT : GOTO 5150
  82. 5120  FOR PART = 1 TO 5: FOR X = 1 TO MX:LST%(X) = X: NEXT :WHERE = MX: FOR X = 1 TO MAX:R =  INT( RND(1) *WHERE) +1:SCL%(PART,X) = LST%(R):LST%(R) = LST%(WHERE):WHERE = WHERE -1:SS =  PEEK(S): NEXT : NEXT 
  83. 5150  RETURN 
  84. 7000  REM 
  85. 7010  IF THIS  THEN  GOSUB 2000
  86. 7020  FOR P = 1 TO 5: GOSUB 1000: NEXT : RETURN 
  87. 9000  REM 
  88. 9010  IF KEY = 147  THEN  POKE 770, SGN(64 - PEEK(770)) *64 + PEEK(770):S =   NOT  SGN(S) * -16336
  89. 9020  RETURN 
  90. 30000  REM 
  91. 30010 D$ =  CHR$(4): NORMAL :LVL =  PEEK(798): IF LVL <0  OR LVL >3  THEN LVL = 0
  92. 30020 L1 = 24576: IF  PEEK(797) = 43  THEN 30050
  93. 30030  PRINT D$;"BLOAD CONSTRUCT": PRINT D$;"BLOAD PICTURES.";V$;",A";L1
  94. 30040  HGR : POKE 797,43
  95. 30050 FILE$ = "SHAPE LENGTHS." +V$: PRINT D$;"OPEN ";FILE$;",D1": PRINT D$;"READ ";FILE$: INPUT MX: DIM PART%(5,MX),SCL%(5,MX),LST%(MX): FOR X = 1 TO MX: FOR PART = 1 TO 5: INPUT PART%(PART,X): NEXT : NEXT 
  96. 30170  PRINT D$;"CLOSE":X$ = "READ": GOSUB 31000: INPUT PL%:: FOR X = 0 TO 3: INPUT OSC%(X): NEXT :OSC% = OSC%(LVL): PRINT D$;"CLOSE": PRINT : RETURN 
  97. 30380 X$ = "WRITE": GOSUB 31000: PRINT PL%:OSC%(LVL) = OSC%: FOR X = 0 TO 3: PRINT OSC%(X): NEXT : PRINT D$;"CLOSE": PRINT : RETURN 
  98. 31000  REM 
  99. 31010  PRINT : PRINT D$;"OPEN SCORE,D1": PRINT D$;X$;"SCORE": RETURN 
  100. 40000  RESUME